home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / worldmap / swivel / swivel.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-05-12  |  14.4 KB  |  442 lines
  1. { SWIVEL: Simple World Interactive Viewing Enhanced Library
  2.      (It's not really very enhanced, but the word fit in the
  3.      acronym so it stands.  Everybody knows that programmers
  4.      think up names first, and then write their programs
  5.      around them.)
  6.   Written by Ken Van Camp
  7.   May 1988
  8.   Released into the public domain by the author.
  9.  
  10.   This program will plot The World Digitized, the data for which
  11.   is Copyright (C) John B. Alison.  I highly recommend that
  12.   anyone who uses this program (and therefore Mr. Alison's data)
  13.   send Mr. Alison the $20 donation he requests (see the READ.ME
  14.   file for his address).
  15. }
  16.  
  17. program SWIVEL;
  18.  
  19. const UP    = 242; DOWN = 250;  LEFT = 245;
  20.       RIGHT = 247; ESC  = 27;   SPACE= 32;
  21.       RET   = 13;
  22.       BLACK = 0;   BLUE = 1;    GREEN = 2;
  23.       CYAN = 3;    RED = 4;     MAGENTA = 5;
  24.       BROWN = 6;   LTGREY = 7;  DKGREY = 8;
  25.       LTBLUE = 9;  LTGRN = 10;  LTCYAN = 11;
  26.       LTRED = 12;  LTMGNT = 13; YELLOW = 14;
  27.       WHITE = 15;
  28.       { SWIVEL commands: }
  29.       VIEW = 1;
  30.       COLOR = 2;
  31.       RESCALE = 3;
  32.       MERCATOR = 4;
  33.       DIRECTORY = 5;
  34.       ERASE = 6;
  35.       ALL = 7;
  36.       QUIT = 8;
  37.       MAXCMMD = 8;       { total # of SWIVEL cmmds currently available }
  38. const COMMANDS: array[1..MAXCMMD] of char = 'VCRMDEAQ';
  39. type text80 = string[80];
  40. var  xmin, xmax, ymin, ymax: real;      { plotting limits }
  41.      c: integer;                        { user input char }
  42.      p: integer;                        { parameter number }
  43.      mercate: boolean;                  { use mercator projection? }
  44.      col: integer;                      { user color number }
  45.      directry: text80;                  { directory for file search }
  46.      erase_cmmds: boolean;              { user want command prompt erased? }
  47.  
  48. {$I GX2DE.PAS}
  49. {$I GXZOOM.PAS}
  50. {$I GXGIN.PAS}
  51.  
  52. procedure initgraphic;
  53. begin
  54.   mercate := TRUE;
  55.   xmin := -246;
  56.   ymin := -4.833;
  57.   xmax := 246;
  58.   ymax := 4.833;
  59.   col := RED;
  60.   directry := '';
  61.   erase_cmmds := FALSE;
  62.  
  63.   clipon2d;
  64.   graphicsopen;
  65.   zoomcolour (12);
  66.   gxborderindex := WHITE;
  67.   window (xmin, ymin, xmax, ymax);
  68.   viewport (1, 1, 639, 300);
  69.   lineindex (WHITE);
  70.   border (WHITE);
  71. end; { initgraphic }
  72.  
  73. procedure grferr (messg: text80);   { error in graphics mode }
  74. begin
  75.   graphicsclose;
  76.   writeln (messg);
  77.   halt(1);
  78. end; { grferr }
  79.  
  80. procedure grid;         { Draw a grid at 20-degree increments }
  81. var x, y, ydelta: real;
  82.     deg90: real;
  83. begin
  84.   x := trunc(xmin/20.0) * 20.0;
  85.   while (x <= xmax) do begin
  86.     if (x < 0.1) and (x > -0.1) then
  87.       lineindex (YELLOW)
  88.     else
  89.       lineindex (WHITE);
  90.     clip2d (x, ymin, x, ymax);
  91.     x := x + 20;
  92.   end;
  93.   if (mercate) then
  94.     ydelta := 20.0 * 2.9 / 85.0
  95.   else
  96.     ydelta := 20.0;
  97.   y := trunc(ymin/ydelta) * ydelta;
  98.   while (y <= ymax) do begin
  99.     if (y < 0.1) and (y > -0.1) then
  100.       lineindex (YELLOW)
  101.     else
  102.       lineindex (WHITE);
  103.     clip2d (xmin, y, xmax, y);
  104.     y := y + ydelta;
  105.   end;
  106.  
  107.   { Draw an outline around the usable space: +-180 degrees longitude,
  108.     +-90 degrees latitude }
  109.   lineindex (YELLOW);
  110.   if (mercate) then
  111.     deg90 := 90.0 * 2.9 / 85.0
  112.   else
  113.     deg90 := 90.0;
  114.   clip2d (-180.0, -deg90, 180.0, -deg90);
  115.   clip2d (180.0, -deg90, 180.0, deg90);
  116.   clip2d (180.0, deg90, -180.0, deg90);
  117.   clip2d (-180.0, deg90, -180.0, -deg90);
  118. end; { grid }
  119.  
  120. { in2real: Read 2 real numbers from a line, and ignore anything after it.
  121.   Return TRUE if successful, or FALSE if the input line is blank.
  122. }
  123. function in2real (var filin: text; var a1, a2: real): boolean;
  124. var Line: string[127];            { line of input }
  125.     p1, p2: integer;              { positions of spaces within line }
  126.     Retcode: integer;             { return code from function }
  127.  
  128. begin
  129.   Line[1] := ' ';
  130.   readln (Filin, Line);
  131.   if (length(Line) = 0) or (Line[1] = ' ') then begin
  132.     in2real := FALSE;
  133.   end else begin
  134.     Line := Line + ' ';
  135.     p1 := pos (' ', Line);
  136.     if (p1 = 0) then
  137.       grferr ('Error 1 reading file');
  138.     val (copy (Line, 1, p1-1), a1, Retcode);
  139.     if (Retcode <> 0) then
  140.       grferr ('Error 2 reading file');
  141.     p2 := pos (' ', copy (Line, p1+1, 100)) + p1;
  142.     if (p2 = 0) then
  143.       grferr ('Error 3 reading file');
  144.     val (copy (Line, p1+1, p2-p1-1), a2, Retcode);
  145.     if (Retcode <> 0) then
  146.       grferr ('Error 4 reading file');
  147.     in2real := TRUE;
  148.   end;
  149. end; { function in2real }
  150.  
  151. function tan (angle: real): real;
  152. begin
  153.   tan := sin(angle) / cos(angle);
  154. end;
  155.  
  156. { mercat: compute the Mercator projection of the latitude }
  157. function mercat (latitude: real): real;
  158. begin
  159.   if (abs (latitude-90) < 1) or (abs (latitude-270) < 1) then
  160.     { too close to pole: don't project }
  161.     mercat := latitude
  162.   else
  163.     mercat := ln (tan ((45.0 + 0.5 * latitude) * 0.01745));
  164. end; { mercat }
  165.  
  166. procedure dispfile (filename: text80);    { Read & display a type-1 map file }
  167. var filin: text;
  168.     lat, long: real;               { latitude & longitude of pt. }
  169.     lastlat, lastlong: real;       { last pt. }
  170.     lastconn: boolean;             { is last pt connected to next one? }
  171.     line: text80;                  { a line of input from text file }
  172. begin
  173.   assign (filin, filename);
  174.   {$I-}
  175.   reset (filin);
  176.   {$I+}
  177.   if (ioresult <> 0) then begin
  178.     gotoxy (1,2);
  179.     write ('File :', filename,
  180.       ': does not exist.  Use D command to set directory');
  181.     delay (3000);
  182.   end else begin
  183.     gotoxy (1,2);
  184.     writeln('Plotting file ', filename,' ...                                ');
  185.     lastconn := FALSE;
  186.     lineindex (col);
  187.     repeat
  188.       if (in2real (filin, lat, long)) then begin
  189.         { a non-blank line was read }
  190.         if (mercate) then
  191.           lat := mercat (lat);
  192.         if (lastconn) then
  193.           clip2d (lastlong, lastlat, long, lat)
  194.         else
  195.           lastconn := TRUE;
  196.         lastlong := long;
  197.         lastlat := lat;
  198.       end else begin
  199.         { blank line read: break vector connection }
  200.         lastconn := FALSE;
  201.       end;
  202.     until (eof (filin));
  203.     close (filin);
  204.   end;
  205. end; { dispfile }
  206.  
  207. { fileprompt: Prompt the user for a file name }
  208. procedure fileprompt;
  209. begin
  210.   if      (pos ('AFRICA', directry) <> 0) or
  211.           (pos ('africa', directry) <> 0) then
  212.     write ('File (AF0,AF1,AF2, or AF3): ')
  213.   else if (pos ('ANTARCTI', directry) <> 0) or
  214.           (pos ('antarcti', directry) <> 0) then
  215.     write ('File (AN0 or AN1): ')
  216.   else if (pos ('ASIA', directry) <> 0) or
  217.           (pos ('asia', directry) <> 0) then
  218.     write ('File (AS0,AS1,AS2, or AS3): ')
  219.   else if (pos ('AUSTRALI', directry) <> 0) or
  220.           (pos ('australi', directry) <> 0) then
  221.     write ('File (AU0,AU1, or AU2): ')
  222.   else if (pos ('EUROPE', directry) <> 0) or
  223.           (pos ('europe', directry) <> 0) then
  224.     write ('File (E0,E1,E2 or E3): ')
  225.   else if (pos ('NORTHAME', directry) <> 0) or
  226.           (pos ('northame', directry) <> 0) then
  227.     write ('File (NA0,NA1,NA2,NA3,USA0,USA1,GR0,GR1, or PA1): ')
  228.   else if (pos ('SOUTHAME', directry) <> 0) or
  229.           (pos ('southame', directry) <> 0) then
  230.     write ('File (SA0,SA1,SA2, or SA3): ')
  231.   else
  232.     write ('Enter file code (e.g., NA0): ');
  233. end; { fileprompt }
  234.  
  235. { checkkey: return TRUE if Escape key pressed, FALSE if no key or any other
  236.   key pressed.
  237. }
  238. function checkkey: boolean;
  239. var c: integer;
  240. begin
  241.   if (keypressed) then begin
  242.     c := getch;
  243.     if (c = ESC) then
  244.       checkkey := TRUE
  245.     else
  246.       checkkey := FALSE;
  247.   end else
  248.     checkkey := FALSE;
  249. end; { checkkey }
  250.  
  251. { all_file_view: Plot all files in succession, checking between each file
  252.   for the Escape key which aborts it
  253. }
  254. procedure all_file_view;
  255. var ctrlfil: text;
  256.     filecol: integer;              { color to plot this file }
  257.     filename: text80;              { file name }
  258. begin
  259.   assign (ctrlfil, 'ALLFILES.DAT');
  260.   {$I-}
  261.   reset (ctrlfil);
  262.   {$I+}
  263.   if (ioresult <> 0) then begin
  264.     write ('ERROR: File ALLFILES.DAT does not exist.');
  265.     delay (3000);
  266.   end else begin
  267.     gotoxy (1,1);
  268.     writeln ('To exit after current file, press Escape.                     ',
  269.              '        ');
  270.     repeat
  271.       readln (ctrlfil, filecol, filename);
  272.       if (filecol <> 0) then begin
  273.         { strip the leading blank off the file name }
  274.         filename := copy (filename, 2, 60);
  275.         col := filecol;
  276.         dispfile (filename);
  277.         if (checkkey) then begin
  278.           write ('STOP THE WORLD, I WANNA GET OFF!');
  279.           delay (3000);
  280.           filecol := 0;
  281.         end;
  282.       end;
  283.     until (filecol = 0) or (eof (ctrlfil));
  284.     close (ctrlfil);
  285.   end;
  286. end; { all_file_view }
  287.  
  288. { cmmd_eval: Evaluate interactive commands }
  289. procedure cmmd_eval;
  290. var c: integer;
  291.     cmmd: integer;
  292.     filename: text80;
  293.     oxmin, oxmax, oymin, oymax: real;      { temps for plot limits }
  294.     xmean, ymean: real;                    { center screen coords }
  295. begin
  296.   repeat
  297.     gotoxy (1,1);
  298.     writeln ('                                                              ',
  299.              '          ');
  300.     writeln ('                                                              ',
  301.              '          ');
  302.     write   ('                                                              ',
  303.              '          ');
  304.     gotoxy (1,1);
  305.     if (NOT erase_cmmds) then
  306.       write ('Command (All/View/Color/Rescale/Mercator/Dir/Erase/Quit): ');
  307.     repeat
  308.       c := getch;
  309.       cmmd := pos (upcase(chr(c)), COMMANDS);
  310.     until (cmmd <> 0);
  311.     writeln (chr(c));
  312.     case cmmd of
  313.       ALL:
  314.         all_file_view;
  315.       VIEW: begin
  316.         fileprompt;
  317.         readln (filename);
  318.         dispfile (concat (directry, '\', filename, '.MP1'));
  319.       end;
  320.       COLOR: begin
  321.         gotoxy (1,1);
  322.         writeln ('1=Blue,2=Green,3=Cyan,4=Red,5=Magenta,6=Brown,7=LtGrey,',
  323.                  '8=DkGrey');
  324.         writeln ('9=LtBlue,10=LtGrn,11=LtCyan,12=LtRed,13=LtMagenta,',
  325.                  '14=Yellow,15=White');
  326.         write ('Enter color number (1-15): ');
  327.         readln (col);
  328.       end;
  329.       RESCALE: begin
  330.         if (mercate) then
  331.           writeln ('Old values are ', xmin:5:2,' ',(ymin*85.0/2.9):5:2,' ',
  332.             xmax:5:2,' ',(ymax*85.0/2.9):5:2)
  333.         else
  334.           writeln ('Old values are ',xmin:5:2,' ',ymin:5:2,' ',xmax:5:2,' ',
  335.             ymax:5:2);
  336.         write ('Enter degrees W-long, S-lat, E-long, N-lat: ');
  337.         oxmin := xmin;
  338.         oxmax := xmax;
  339.         oymin := ymin;
  340.         oymax := ymax;
  341.         readln (xmin, ymin, xmax, ymax);
  342.         if (xmin >= xmax) or (ymin >= ymax) then begin
  343.           write ('ILLEGAL SCALE');
  344.           delay (5000);
  345.           xmin := oxmin;
  346.           xmax := oxmax;
  347.           ymin := oymin;
  348.           ymax := oymax;
  349.         end else begin
  350.           { keep the latitude-longitude scaling true for typical screen }
  351.           if ((xmax-xmin) / (ymax-ymin) > (246.0/141.66)) then begin
  352.             { X scale larger than Y: increase Y }
  353.             ymean := (ymin + ymax) / 2.0;
  354.             ymin := ymean - (xmax - xmin) * 0.5 * 141.66 / 246.0;
  355.             ymax := ymean + (xmax - xmin) * 0.5 * 141.66 / 246.0;
  356.           end else begin
  357.             { Y scale larger than X: increase X }
  358.             xmean := (xmin + xmax) / 2.0;
  359.             xmin := xmean - (ymax - ymin) * 0.5 * 246.0 / 141.66;
  360.             xmax := xmean + (ymax - ymin) * 0.5 * 246.0 / 141.66;
  361.           end;
  362.           if (mercate) then begin
  363.             { scale Y plotting limits to Mercator displacement units }
  364.             ymin := ymin * 2.9 / 85.0;
  365.             ymax := ymax * 2.9 / 85.0;
  366.           end;
  367.           window (xmin, ymin, xmax, ymax);
  368.           graphics (0, col);     { clear the screen }
  369.           grid;
  370.         end; { if xmin >= xmax ... }
  371.       end;
  372.       MERCATOR: begin
  373.         if (mercate) then begin
  374.           writeln ('MERCATOR option is now OFF.');
  375.           mercate := FALSE;
  376.           { scale Y plotting limits to degrees }
  377.           ymin := ymin * 85.0 / 2.9;
  378.           ymax := ymax * 85.0 / 2.9;
  379.         end else begin
  380.           writeln ('MERCATOR option is now ON.');
  381.           mercate := TRUE;
  382.           { scale Y plotting limits to Mercator displacement units }
  383.           ymin := ymin * 2.9 / 85.0;
  384.           ymax := ymax * 2.9 / 85.0;
  385.         end;
  386.         window (xmin, ymin, xmax, ymax);
  387.         delay (3000);
  388.       end;
  389.       DIRECTORY: begin
  390.         writeln ('Select AFRICA, ANTARCTI, ASIA, AUSTRALI, EUROPE, NORTHAME,',
  391.           'or SOUTHAME.');
  392.         write ('Enter default directory: ');
  393.         readln (directry);
  394.       end;
  395.       ERASE:
  396.         erase_cmmds := NOT erase_cmmds;
  397.     end; { case }
  398.   until (cmmd = QUIT);
  399. end; { cmmd_eval }
  400.  
  401. begin { main }
  402.   if (paramcount > 0) then begin
  403.     writeln ('  SWIVEL: Simple World Interactive Viewing Enhanced Library');
  404.     writeln ('Version 1.0 by Ken Van Camp  May 1988');
  405.     writeln ('SWIVEL is in the public domain, and may not be distributed');
  406.     writeln ('for profit.');
  407.     writeln ('  usage: SWIVEL');
  408.     writeln ('Any parameters brings up this help screen.');
  409.     writeln ('Available commands from within SWIVEL are:');
  410.     writeln ('  A - View all files (specified in ALLFILES.DAT)');
  411.     writeln ('  V - Specify another file to view');
  412.     writeln ('  C - Specify new color # to use for plotting');
  413.     writeln ('  R - Rescale the plot to new limits (specify in degrees)');
  414.     writeln ('  M - Toggle use of Mercator projection (default is ON)');
  415.     writeln ('  D - Change directory to search for file specified with V');
  416.     writeln ('  E - Erase the command prompt from screen (for printing)');
  417.     writeln ('  Q - Quit from SWIVEL');
  418.     writeln ('NOTES:');
  419.     writeln ('To specify a file to read, first set the default directory for');
  420.     writeln ('searching with the D command.  The use V to specify the file ',
  421.              'name');
  422.     writeln ('Do NOT include the .MP1 file name extension.');
  423.     writeln ('    When rescaling, just separate the four numbers by a space');
  424.     writeln ('(no commas allowed).  Grid lines are always drawn in 20-degree');
  425.     write   ('increments.');
  426.     halt(1);
  427.   end;
  428.   initgraphic;
  429.   grid;
  430.   gotoxy (15,1);
  431.   write ('SWIVEL: Simple World Interactive Viewing Enhanced Library');
  432.   delay (2000);
  433.   gotoxy (15,1);
  434.   write ('        Version 1.0  by Ken Van Camp   (May 1988)        ');
  435.   delay (2000);
  436.   gotoxy (15,1);
  437.   write ('            LET YOUR FINGERS DO THE WALKING!             ');
  438.   delay (2000);
  439.   cmmd_eval;
  440.   graphicsclose;
  441. end. {main}
  442.